home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pasnews.zip / TEXTLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1990-05-22  |  5KB  |  222 lines

  1. Unit TextList;
  2.  
  3. {*****************************************************************************
  4.  * This unit creates a basic list of text strings.  It uses TP 5.5's object  *
  5.  * oriented features for program extensibility.                              *
  6.  *****************************************************************************}
  7.  
  8. Interface
  9.  
  10. Const
  11.    MaximumTextSize = 65;   {Set this to the maximum text string size}
  12.  
  13. Type
  14.  
  15.    TextString  = string[MaximumTextSize];
  16.  
  17.    TextPointer = ^TextRecord;
  18.  
  19.    TextRecord  = Record  {This is the main list record}
  20.                     P ,                   {Pointer to previous record}
  21.                     N : TextPointer;      {Pointer to next record    }
  22.                     S : TextString;       {The text value            }
  23.                  End;
  24.  
  25.    TextObject  = Object
  26.  
  27.                     {These are the Object's variables}
  28.                     FirstRec,                {Pointer to top of list          }
  29.                     LastRec ,                {Pointer to bottom of list       }
  30.                     ThisRec : TextPointer;   {Pointer to current list item    }
  31.                     EOFRec  ,          {TRUE if attempt to go below last item }
  32.                     TOFRec  : boolean; {TRUE if attempt to go above first item}
  33.                     NoRecs  ,            {Number of records in list           }
  34.                     RecNo   : integer;   {Relative number of current list item}
  35.  
  36.                     {These are the Object's methods}
  37.                     Procedure Init      ;
  38.                     Procedure Done      ;
  39.                     Procedure AddRec    (T : TextString);
  40.                     Procedure DelRec    ;
  41.                     Procedure ChgRec    (T : TextString);
  42.                     Function  GetRec    : TextString;
  43.                     Procedure TopRec    ;
  44.                     Procedure BottomRec ;
  45.                     Procedure UpRec     (I : word);
  46.                     Procedure DownRec   (I : word);
  47.                  End;
  48.  
  49. Implementation
  50.  
  51. Procedure TextObject.Init;
  52. {Initialization routine.  Setup the list parameters.}
  53. Begin
  54.    FirstRec := Nil;
  55.    LastRec  := Nil;
  56.    ThisRec  := Nil;
  57.    EOFRec   := True;
  58.    TOFRec   := True;
  59.    NoRecs   := 0;
  60.    RecNo    := 0;
  61. End;
  62.  
  63. Procedure TextObject.Done;
  64. {Termination routine.  Deallocate the list and reset the parameters.}
  65. Begin
  66.    ThisRec := FirstRec;
  67.    While ThisRec <> Nil Do
  68.    Begin
  69.       FirstRec := FirstRec^.N;
  70.       Dispose(ThisRec);
  71.       ThisRec := FirstRec;
  72.    End;
  73.    LastRec := Nil;
  74.    EOFRec  := True;
  75.    TOFRec  := True;
  76.    NoRecs  := 0;
  77.    RecNo   := 0;
  78. End;
  79.  
  80. Procedure TextObject.AddRec (T : TextString);
  81. {Add a new list item below the current item}
  82. Var
  83.    R : TextPointer;
  84. Begin
  85.    New(R);
  86.    Inc(NoRecs);
  87.    Inc(RecNo);
  88.    EOFRec := False;
  89.    TOFRec := False;
  90.    R^.S := T;
  91.    If FirstRec = Nil Then
  92.    Begin
  93.       FirstRec := R;
  94.       R^.P     := Nil;
  95.       R^.N     := Nil;
  96.    End
  97.    Else
  98.    Begin
  99.       R^.N       := ThisRec^.N;
  100.       R^.P       := ThisRec;
  101.       ThisRec^.N := R;
  102.    End;
  103.    If R^.N = Nil Then
  104.       LastRec := R
  105.    Else
  106.       R^.N^.P := R;
  107.    ThisRec := R;
  108. End;
  109.  
  110. Procedure TextObject.DelRec;
  111. {Delete the current list item}
  112. Var
  113.    R : TextPointer;
  114. Begin
  115.    If ThisRec <> Nil Then
  116.    Begin
  117.       R := ThisRec;
  118.       ThisRec := R^.N;
  119.       If R^.P = Nil Then
  120.          FirstRec := R^.N
  121.       Else
  122.          R^.P^.N := R^.N;
  123.       If R^.N = Nil Then
  124.       Begin
  125.          LastRec := R^.P;
  126.          ThisRec := R^.P;
  127.          EOFRec  := True;
  128.          Dec(RecNo);
  129.       End
  130.       Else
  131.          R^.N^.P := R^.P;
  132.       Dispose(R);
  133.       Dec(NoRecs);
  134.    End;
  135. End;
  136.  
  137. Procedure TextObject.ChgRec(T : TextString);
  138. {Change the text value of the current list item}
  139. Begin
  140.    If ThisRec <> Nil Then
  141.       ThisRec^.S := T;
  142. End;
  143.  
  144. Function TextObject.GetRec : TextString;
  145. {Return the text value of the current list item}
  146. Begin
  147.    If ThisRec <> Nil Then
  148.       GetRec := ThisRec^.S
  149.    Else
  150.       GetRec := '<<EMPTY>>';
  151. End;
  152.  
  153. Procedure TextObject.TopRec;
  154. {Move to the top-most list item}
  155. Begin
  156.    ThisRec := FirstRec;
  157.    If ThisRec <> Nil Then
  158.    Begin
  159.       EOFRec := False;
  160.       TOFRec := False;
  161.       RecNo  := 1;
  162.    End
  163.    Else {the list is empty}
  164.    Begin
  165.       EOFRec := True;
  166.       TOFRec := True;
  167.       RecNo  := 0;
  168.    End;
  169. End;
  170.  
  171. Procedure TextObject.BottomRec;
  172. {Move to the bottom-most list item}
  173. Begin
  174.    ThisRec := LastRec;
  175.    If ThisRec <> Nil Then
  176.    Begin
  177.       EOFRec := False;
  178.       TOFRec := False;
  179.       RecNo  := NoRecs;
  180.    End
  181.    Else {the list is empty}
  182.    Begin
  183.       RecNo  := 0;
  184.       EOFRec := True;
  185.       TOFRec := True;
  186.    End;
  187. End;
  188.  
  189. Procedure TextObject.UpRec (I : word);
  190. {Move up the list 'I' items}
  191. Var
  192.    J : word;
  193. Begin
  194.    J := I;
  195.    While (J > 0) and (ThisRec <> FirstRec) Do
  196.    Begin
  197.       ThisRec := ThisRec^.P;
  198.       Dec(J);
  199.       Dec(RecNo);
  200.    End;
  201.    TOFRec := J > 0;
  202.    EOFRec := ThisRec = Nil;
  203. End;
  204.  
  205. Procedure TextObject.DownRec (I : word);
  206. {Move down the list 'I' items}
  207. Var
  208.    J : word;
  209. Begin
  210.    J := I;
  211.    While (J > 0) and (ThisRec <> LastRec) Do
  212.    Begin
  213.       ThisRec := ThisRec^.N;
  214.       Dec(J);
  215.       Inc(RecNo);
  216.    End;
  217.    EOFRec := J > 0;
  218.    TOFRec := ThisRec = Nil;
  219. End;
  220.  
  221. Begin
  222. End.